home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / sys / unix_mipsco.t < prev    next >
Encoding:
Text File  |  1990-10-15  |  5.8 KB  |  162 lines
  1. (herald bsd4_2 (env tsys))
  2.  
  3. (define file-mode/in     #o0)
  4. (define file-mode/out    #o3001)
  5. (define file-mode/append #o1011)
  6.  
  7. (define-constant number-of-signals 27)   ;4.2
  8.  
  9. (define FIONREAD (make-bytev 4))
  10. (set (bref-16-u fionread 0) #x4004)
  11. (set (bref-16-u fionread 2) #x667f)
  12.  
  13.  
  14. ;;; handler-types (Htype): A = asynchronous, E = exception, D = default,
  15. ;;; I = ignore
  16. ;;; (sig# handler-type handler description)
  17.  
  18. (define *signals*
  19.   '(;( 1   E    non-continuable  "hangup")
  20.  ;   ( 2   A    sigint-handler    "interrupt")
  21.  ;   ( 3   A    siquit-handler    "quit")
  22.     ( 4   E    non-continuable  "illegal instruction")
  23.     ( 5   E    non-continuable  "trace/BPT trap")
  24.     ( 6   E    non-continuable  "IOT instruction")
  25.     ( 7   E    non-continuable  "EMT instruction")
  26.     ( 8   E    non-continuable  "floating point exception")
  27.  ;   ( 9   D    default          "kill")
  28.     (10   E    non-continuable  "memory protection violation")
  29.     (11   E    non-continuable  "reference to non-existent memory")
  30.     (12   E    non-continuable  "bad argument to a system call")
  31.     (13   E    non-continuable  "broken pipe")
  32.  ;   (14   D    default          "alarm clock")
  33.  ;   (15   A    sigterm-handler   "software termination signal")
  34.  ;   (16   D    default          "urgent condition on socket")
  35.  ;   (17   D    default          "stop")
  36.  ;   (18   D    default          "stop signal generated from keyboard")
  37.  ;   (19   D    default          "continue after stop")
  38.  ;   (20   D    default          "child status has changed")
  39.  ;   (21   D    default          "background read attempted")
  40.  ;   (22   D    default          "background write attempted")
  41.  ;   (23   D    default          "i/o is possible")
  42.     (24   E    non-continuable  "cpu time limit exceeded")
  43.     (25   E    non-continuable  "file size limit exceeded")
  44.   ;  (26   D    default          "virtual time alarm")
  45.   ;  (27   D    default          "profiling timer alarm")
  46.   ))
  47.  
  48. (define-constant %%SIGINT     2)
  49. (define-constant %%SIGQUIT    3)
  50. (define-constant %%SIGTERM    15)
  51. (define-constant %%SIGSTOP    17)
  52.  
  53. (define-foreign r-nlistone
  54.   ("nlistone" (in rep/string filename)
  55.         (in rep/string functionName))
  56.   rep/integer)
  57.  
  58. (define-integrable (t-nlistone file function)
  59.   (r-nlistone (string->asciz! (copy-string file))
  60.           (string->asciz! (copy-string function))))
  61.  
  62.  
  63.  
  64. ;;; loader for foreign code under Unix ... in particular, C
  65. ;;; by Dorab Patel <dorab@neptune.cs.ucla.edu>
  66. ;;; Original: Feb 29, 1984
  67. ;;; Modified for t2.8: May 22, 1984     dorab@neptune.cs.ucla.edu
  68. ;;; Modified for t3: Dec 24, 1986       dorab@neptune.cs.ucla.edu
  69.  
  70. (define (make-foreign-procedure sym)
  71.   (let ((xeno (make-foreign sym))
  72.     (addr (t-nlistone (check-arg file-exists?
  73.                    (reloc-file)
  74.                    make-foreign-procedure)
  75.             (symbol->string sym))))
  76.        (cond ((fxn= addr 0)
  77.           (set (mref-integer xeno 4) addr)
  78.           xeno)
  79.          (else
  80.           (error "foreign procedure \"~a\" does not exist in file \"~a\""
  81.              (symbol->string sym)
  82.              (reloc-file))))))
  83.  
  84.  
  85. ;;; searchpath is a general utility function that takes a colon-separated
  86. ;;; path list and a filename, and finds the first file that exists in that
  87. ;;; directory list.
  88. ;;; maybe it should be elsewhere ?
  89. ;;; *********************************************************************
  90. (define (searchpath path file)
  91.   (labels (
  92.        ;; convert a colon-separated path into a list.
  93.        ;; empty fields map to the current directory "."
  94.        ;; **********************
  95.        ((splitpath path)
  96.         (iterate
  97.          loop
  98.          ((xpath path) (rv '()))        ; initialization
  99.          (if (string-empty? xpath)        ; if end of loop with colon
  100.          (reverse! (cons "." rv))    ; return with .
  101.          (let ((index (string-posq #\: xpath)))
  102.               (if index        ; if a colon exists
  103.               (if (fx= index 0)
  104.                   (loop (chdr xpath) (cons "." rv))
  105.                   (loop (nthchdr xpath (fx+ index 1))
  106.                     (cons (substring xpath 0 index)
  107.                       rv)))
  108.               (reverse! (cons xpath rv)))))))) ; return from loop
  109.       
  110.       ;; start of searchpath
  111.       ;; *******************
  112.       (if (and (char= (char file) #\slash)        ; if name starts with /
  113.            (file-exists? (->filename file)))    ; and it exists
  114.           file                    ; return it
  115.           (iterate loop ((xpath (splitpath path)))
  116.                (cond ((null? xpath) '#f) ; not found
  117.                  (else (let ((xfile    ; form full path name
  118.                         (string-append (car xpath)
  119.                                    "/"
  120.                                    file)))
  121.                     (if (file-exists? (->filename xfile))
  122.                         xfile
  123.                         (loop (cdr xpath))))))))))
  124.  
  125. ;;; reloc-file contains the full path name of the file containing
  126. ;;; all the namelist information for the currently running Tau process.
  127. ;;; it is used by make-foreign-procedure and load-unix
  128. ;;; (reloc-file) returns the pathname
  129. ;;; (set (reloc-file) val) is used to set the name of the Tau binary to "val"
  130. ;;; (insert reloc-file v) is used to change the value of reloc-file to "v"
  131. ;;; (delete reloc-file nil) is used to delete the current reloc-file
  132. ;;; **********************************************************************
  133. (define reloc-file
  134.   (let ((orig "/usr/local/t")        ; default
  135.     (x "/usr/local/t"))
  136.        (object (lambda () x)
  137.            ((insert self v)
  138.         (set x (enforce string? v)))
  139.            ((delete self v)    ; need two args -- hack!
  140.         (ignore v)
  141.         (or (string-equal? x orig)    ; if not orig
  142.             (not (file-exists? x))    ; and it exists
  143.             (file-delete x)))        ; then delete it
  144.            ((setter reloc-file)
  145.         (lambda (val)
  146.             (set orig (enforce string? val)))))))
  147.  
  148. (define (initialize-local-system)
  149.   (cond ((searchpath (unix-getenv (copy-string "PATH")) 
  150.                      (car (command-line)))
  151.        => (lambda (tau)
  152.           (set (reloc-file) tau)    ; set orig value of reloc-file
  153.           (insert reloc-file tau)    ; set current value
  154.           (insert exit-agenda    ; to remove reloc files on exit
  155.               (lambda () (delete reloc-file nil)))))
  156.   (else (format (error-output)
  157.         "Could not find full path name for ~a~%"
  158.         (car (command-line))))))
  159.  
  160.  
  161. (define (load-foreign file . rest) nil)
  162.